home *** CD-ROM | disk | FTP | other *** search
/ The Very Best of Atari Inside / The Very Best of Atari Inside 1.iso / sharew / chemie / molmasse / molmasse.lst < prev    next >
Encoding:
File List  |  1991-04-07  |  7.5 KB  |  248 lines
  1. ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  2. '  Wilfried Cordes, Kennedystraße 20, 2900 Oldenburg, Tel.: 0441-53088
  3. '  Accessory zur Bestimmung von Molmassen
  4. ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  5. ' 1000 Bytes Speicher reichen
  6. $m1000
  7. '
  8. ' Anwendung beim AES anmelden
  9. ap_id&=APPL_INIT()
  10. programm!=ap_id&=0
  11. ' *
  12. ' * Ressourcebaumadressen holen
  13. ' *
  14. INLINE rsc%,1838
  15. setze_koordinaten(0,eingabe_adr%,rsc%)
  16. rechte&=2
  17. wert&=4
  18. ergebnis&=6
  19. rechne&=8
  20. schluss&=9
  21. prozent1&=12
  22. setze_koordinaten(1,rechte_adr%,rsc%)
  23. '
  24. atomliste$=" HHeLiBe B C N O FNeNaMgAlSi P SClAr KCaScTi VCrMnFeCoNiCuZnGaGeAsSeBrKrRbSr YZrNbMoTcRuRhPdAgCdInSnSbTe IXeCsBaHfTa WReOsIrPtAuHgTlPbBiPo"
  25. OPTION BASE 1
  26. DIM atomgewicht(69)
  27. DIM gewicht(12)                  !Gewicht pro Atom in der Formel
  28. DIM atomsymbol$(12)
  29. FOR m&=1 TO 69
  30.   READ atomgewicht(m&)
  31. NEXT m&
  32. DATA 1.0079,4.00260,6.941,9.01218,10.81
  33. DATA 12.011,14.0067,15.9994,18.99840,20.179
  34. DATA 22.98977,24.305,26.98154,28.086
  35. DATA 30.97376,32.06,35.453,39.948
  36. DATA 39.098,40.08,44.9559,47.90,50.9414
  37. DATA 51.996,54.9380,55.847,58.9332,58.70,63.546,65.38
  38. DATA 69.72,72.59,74.9216,78.96,79.904,83.80
  39. DATA 85.4678,87.62,88.9059,91.22,92.9064,95.94
  40. DATA 97,101.07,102.9055,106.4,107.868,112.40
  41. DATA 114.82,118.69,121.75,127.60,126.9045,131.30
  42. DATA 132.9055,137.34,178.49,180.9479,183.85
  43. DATA 186.207,190.2,192.22,195.09,196.9665,200.59
  44. DATA 204.37,207.19,208.9806,210
  45. '
  46. IF NOT programm!
  47.   ' Accessorynamen ins Deskmenü eintragen
  48.   IF MENU_REGISTER(ap_id&,"  Molmasse...")=-1
  49.     ' Kein Platz im Deskmenü
  50.     DO
  51.       ~EVNT_TIMER(-1)
  52.     LOOP
  53.   ENDIF
  54. ENDIF
  55. '
  56. DO
  57.   IF NOT programm!
  58.     ~EVNT_MESAG(0) !Auf's angeklickt werden warten
  59.   ENDIF
  60.   IF MENU(1)=40 OR programm!    !'AC_OPEN'
  61.     DEFMOUSE 0
  62.     ' Menüleiste sperren
  63.     ~WIND_UPDATE(1)
  64.     ' Dialogboxkoordinaten auf Bildschirm zentrieren
  65.     ~FORM_CENTER(eingabe_adr%,x&,y&,b&,h&)
  66.     ' Bildschirmplatz reservieren
  67.     ~FORM_DIAL(0,0,0,0,0,x&,y&,b&,h&)
  68.     ' Eingabezeile leeren
  69.     BYTE{{OB_SPEC(eingabe_adr%,wert&)}}=0
  70.     '
  71.     ' Molmasse zu Anfang 0 Gramm
  72.     CHAR{OB_SPEC(eingabe_adr%,ergebnis&)}="0"
  73.     FOR m&=prozent1& TO prozent1&+12
  74.       CHAR{OB_SPEC(eingabe_adr%,m&)}=""
  75.     NEXT m&
  76.     '
  77.     REPEAT
  78.       abbruch!=FALSE
  79.       '
  80.       ' Ausgangsknöpfe entfärben
  81.       undo(eingabe_adr%,rechne&)
  82.       undo(eingabe_adr%,schluss&)
  83.       '
  84.       ' Dialogbox zeichnen
  85.       ~OBJC_DRAW(eingabe_adr%,0,3,x&,y&,b&,h&)
  86.       '
  87.       ' Dialog durchführen
  88.       r_obj%=FORM_DO(eingabe_adr%,0)
  89.       '
  90.       SELECT r_obj%
  91.       CASE rechne&
  92.         '
  93.         ' Text aus Dialogbox holen
  94.         text$=CHAR{{OB_SPEC(eingabe_adr%,wert&)}}
  95.         '
  96.         CLR summe
  97.         atomanzahl&=1
  98.         FOR m&=prozent1& TO prozent1&+12
  99.           CHAR{OB_SPEC(eingabe_adr%,m&)}=""
  100.         NEXT m&
  101.         IF text$<>""
  102.           FOR ort&=1 TO LEN(text$)
  103.             ' Alle eingegebenen Zeichen überprüfen
  104.             buchstabe$=MID$(text$,ort&,1)
  105.             IF buchstabe$>="A" AND buchstabe$<="Z"
  106.               '
  107.               ' Eingelesenes Zeichen ist großer Buchstabe
  108.               a$=MID$(text$,ort&+1,1)
  109.               '
  110.               IF a$>="a" AND a$<="z"
  111.                 ' Großer Buchstabe hat kleinen Buchstaben als Nachbarn
  112.                 ' Ist Kombination in Atomliste?
  113.                 stelle&=INSTR(atomliste$,buchstabe$+a$)
  114.                 IF stelle&>0
  115.                   ' Kombination gefunden
  116.                   atomsymbol$(atomanzahl&)=buchstabe$+a$
  117.                   INC ort&
  118.                   hole_haeufigkeit(stelle&,ort&,summe)
  119.                 ELSE
  120.                   ' Kombination nicht gefunden, nach einzelnem Buchstaben suchen
  121.                   atomsymbol$(atomanzahl&)=" "+buchstabe$
  122.                   stelle&=INSTR(atomliste$," "+buchstabe$)
  123.                   hole_haeufigkeit(stelle&,ort&,summe)
  124.                 ENDIF
  125.               ELSE
  126.                 ' Buchstabe hat Zahl oder nichts als Nachbarn
  127.                 atomsymbol$(atomanzahl&)=" "+buchstabe$
  128.                 stelle&=INSTR(atomliste$," "+buchstabe$)
  129.                 hole_haeufigkeit(stelle&,ort&,summe)
  130.               ENDIF
  131.               '
  132.             ELSE
  133.               abbruch!=TRUE
  134.             ENDIF
  135.             EXIT IF abbruch!
  136.           NEXT ort&
  137.         ENDIF
  138.         '
  139.         IF NOT abbruch!
  140.           IF atomanzahl&>1
  141.             ' Molekülgewicht in Dialogbox schreiben
  142.             CHAR{OB_SPEC(eingabe_adr%,ergebnis&)}=STR$(summe)
  143.             FOR atom&=1 TO MIN(atomanzahl&-1,12)
  144.               anteil=100*gewicht(atom&)/summe
  145.               CHAR{OB_SPEC(eingabe_adr%,prozent1&+atom&-1)}=atomsymbol$(atom&)+": "+STR$(ROUND(anteil,2),5,2)+" %"
  146.             NEXT atom&
  147.           ENDIF
  148.         ELSE
  149.           ' Fehlerhafte Eingabe
  150.           ~FORM_ALERT(1,"[3][Eingabe kann nicht|ausgewertet werden.][Weiter]")
  151.           CHAR{OB_SPEC(eingabe_adr%,ergebnis&)}="0"
  152.         ENDIF
  153.         '
  154.       CASE rechte&
  155.         ~FORM_CENTER(rechte_adr%,xx&,yy&,bb&,hh&)
  156.         ~OBJC_DRAW(rechte_adr%,0,3,xx&,yy&,bb&,hh&)
  157.         ~FORM_DO(rechte_adr%,0)
  158.       ENDSELECT
  159.     UNTIL r_obj%=schluss&
  160.     '
  161.     ' Botschaft an Hauptprogramm zur Bildschirmrestaurierung schicken
  162.     ~FORM_DIAL(3,0,0,0,0,x&,y&,b&,h&)
  163.     ' Menüs dürfen wieder klappen
  164.     ~WIND_UPDATE(0)
  165.   ENDIF
  166.   EXIT IF programm!
  167. LOOP
  168. '
  169. ' Programmende
  170. ~RSRC_FREE()
  171. END
  172. '
  173. PROCEDURE hole_haeufigkeit(stelle&,VAR ort&,summe)
  174.   ' Element ist in Liste, nun zugehörigen Zahlenwert bestimmen
  175.   LOCAL menge&
  176.   '
  177.   IF stelle&>0 AND ODD(stelle&)
  178.     ' Umrechnung von Position in String
  179.     ' auf atomgewicht()-Feldindex
  180.     DIV stelle&,2
  181.     INC stelle&
  182.     '
  183.     ' ort& zeigt auf erstes Zeichen nach dem Elementsymbol
  184.     INC ort&
  185.     '
  186.     ' Zahlenwert der Zeichen nach dem Elementsymbol bestimmen
  187.     menge&=VAL(MID$(text$,ort&))
  188.     '
  189.     ' Wenn Zahl gefunden (menge&>0), Textzeiger neu stellen
  190.     IF menge&>0
  191.       ' Korrektur wegen interner Zahlendarstellung
  192.       ADD ort&,LOG10(menge&)+0.001
  193.     ELSE
  194.       menge&=1
  195.       DEC ort&  !wegen NEXT ort& in Haupschleife
  196.     ENDIF
  197.     '
  198.     ' Molekülgewicht aufaddieren
  199.     ADD summe,atomgewicht(stelle&)*menge&
  200.     gewicht(atomanzahl&)=atomgewicht(stelle&)*menge&
  201.     INC atomanzahl&
  202.   ELSE
  203.     abbruch!=TRUE
  204.   ENDIF
  205. RETURN
  206. '
  207. ' Objekt desaktivieren
  208. PROCEDURE disable(baum_adr%,objekt&)
  209.   OB_STATE(baum_adr%,objekt&)=BSET(OB_STATE(baum_adr%,objekt&),3)
  210. RETURN
  211. ' Objekt aktivieren
  212. PROCEDURE enable(baum_adr%,objekt&)
  213.   OB_STATE(baum_adr%,objekt&)=BCLR(OB_STATE(baum_adr%,objekt&),3)
  214. RETURN
  215. ' Knopf entfärben
  216. PROCEDURE undo(baum_adr%,objekt&)
  217.   OB_STATE(baum_adr%,objekt&)=BCLR(OB_STATE(baum_adr%,objekt&),0)
  218. RETURN
  219. ' *
  220. ' Koordinaten in INLINE-Ressource berechnen
  221. ' *
  222. PROCEDURE setze_koordinaten(baum&,VAR adr%,rsc%)
  223.   LOCAL nummer&,adresse%,tabelle&
  224.   '
  225.   tabelle&=CARD{rsc%+18}
  226.   adr%={tabelle&+rsc%+baum&*4}+rsc%
  227.   nummer&=0
  228.   REPEAT
  229.     ~RSRC_OBFIX(adr%,nummer&)
  230.     SELECT OB_TYPE(adr%,nummer&)
  231.     CASE 21,22,29,30,31
  232.       OB_SPEC(adr%,nummer&)=OB_SPEC(adr%,nummer&)+rsc%
  233.       adresse%=OB_SPEC(adr%,nummer&)
  234.       {adresse%}={adresse%}+rsc%
  235.       {adresse%+4}={adresse%+4}+rsc%
  236.       {adresse%+8}={adresse%+8}+rsc%
  237.     CASE 23,24     !BITBLK,USERDEF
  238.       OB_SPEC(adr%,nummer&)=OB_SPEC(adr%,nummer&)+rsc%
  239.       adresse%=OB_SPEC(adr%,nummer&)
  240.       {adresse%}={adresse%}+rsc%
  241.     CASE 26,28,32
  242.       OB_SPEC(adr%,nummer&)=OB_SPEC(adr%,nummer&)+rsc%
  243.     ENDSELECT
  244.     '
  245.     INC nummer&
  246.   UNTIL BTST(OB_FLAGS(adr%,nummer&-1),5)
  247. RETURN
  248.